;;; lang3-4

(module lang
  (lib "eopl.ss" "eopl")                
  
  (require "drscheme-init.scm")
  
  (provide (all-defined))
  
  ;;;;;;;;;;;;;;;; grammatical specification ;;;;;;;;;;;;;;;;
  
  (define the-lexical-spec
    '((whitespace (whitespace) skip)
      (comment ("%" (arbno (not #\newline))) skip)
      (identifier
       (letter (arbno (or letter digit "_" "-" "?")))
       symbol)
      (number (digit (arbno digit)) number)
      (number ("-" digit (arbno digit)) number)
      ))
  
  (define the-grammar
    '((program (expression) a-program)
      
      (expression (number) const-exp)
      (expression
       ("-" "(" expression "," expression ")")
       diff-exp)
      
      (expression
       ("zero?" "(" expression ")")
       zero?-exp)
      
      (expression
       ("if" expression "then" expression "else" expression)
       if-exp)
      
      (expression (identifier) var-exp)
      
      (expression
       ("let" identifier "=" expression "in" expression)
       let-exp)
      
      (expression 
       ("proc" "("  identifier ":" optional-type ")" expression)
       proc-exp)
      
      (expression
       ("(" expression expression ")")
       call-exp)
      
      (expression
       ("letrec"
        optional-type identifier "(" identifier ":" optional-type ")"
        "=" expression "in" expression)
       letrec-exp)
      
      (expression
       ("list" "(" expression (arbno "," expression) ")")
       list-exp)
      
      (expression
       ( "cons" "(" expression "," expression ")" )
       cons-exp)
      
      (expression
       ("car" "(" (arbno expression) ")")
       car-exp)
      
      (expression
       ("cdr" "(" (arbno expression) ")")
       cdr-exp)
      
      (expression
       ( "null?" "(" expression ")" )
       null-exp)
      
      (expression
       ("emptylist")
       emptylist-exp)
      
;;Adding the Explicit refs 
      (expression
        ("begin" expression (arbno ";" expression) "end")
        begin-exp)

      (expression
        ("newref" "(" expression ")")
        newref-exp)

      (expression
        ("deref" "(" expression ")")
        deref-exp)

      (expression
        ("setref" "(" expression "," expression ")")
        setref-exp)
      
      
      (optional-type
       ("?")
       no-type)
      
      (optional-type
       (type)
       a-type)
      
      (type
       ("int")
       int-type)
      
      (type
       ("bool")
       bool-type)
      
      (type
       ("(" type "->" type ")")
       proc-type)
      
      ;;;;;;;;;;;;;;;;;;;;;what is % here?????????????????????????
      (type
       ("%tvar-type" number)
       tvar-type)
      
      (type
       ("listof" type)
       list-type)
      
      (type
       ("refto" type)
       refto-type)
      
      (type
       ("void")
       void-type)      
      
      ))
  
  (define the-field-names
    '((a-program exp)
      (const-exp n)
      (zero?-exp e1)
      (if-exp e0 e1 e2)
      (diff-exp e1 e2)
      (var-exp id)
      (let-exp bvar rhs body)
      (proc-exp bvar otype body)
      (call-exp rator rand)
      (letrec-exp otype1 proc-name bvar otype2 proc-body letrec-body)
      (int-type)
      (bool-type)
      (proc-type arg-type result-type)
      (no-type)
      (a-type type)
      (tvar-type serial-number)
      ))
  
  ;;;;;;;;;;;;;;;; sllgen boilerplate ;;;;;;;;;;;;;;;;
  
  (sllgen:make-define-datatypes the-lexical-spec the-grammar)
  
  (define show-the-datatypes
    (lambda () (sllgen:list-define-datatypes the-lexical-spec the-grammar)))
  
  (define scan&parse
    (sllgen:make-string-parser the-lexical-spec the-grammar))
  
  (define just-scan
    (sllgen:make-string-scanner the-lexical-spec the-grammar))
  
  
  
  ;;;;;;;;;;;;;;;; syntactic tests and observers ;;;;;;;;;;;;;;;;
  
  (define atomic-type?
    (lambda (ty)
      (cases type ty
        (proc-type (ty1 ty2) #f)
        (tvar-type (sn) #f)
        (else #t))))
  
  (define proc-type?
    (lambda (ty)
      (cases type ty
        (proc-type (t1 t2) #t)
        (else #f))))
  
  (define tvar-type?
    (lambda (ty)
      (cases type ty
        (tvar-type (serial-number) #t)
        (else #f))))
  
  
  (define proc-type->arg-type
    (lambda (ty)
      (cases type ty
        (proc-type (arg-type result-type) arg-type)
        (else (eopl:error 'proc-type->arg-type
                          "Not a proc type: ~s" ty)))))
  
  (define proc-type->result-type
    (lambda (ty)
      (cases type ty
        (proc-type (arg-type result-type) result-type)
        (else (eopl:error 'proc-type->result-types
                          "Not a proc type: ~s" ty)))))
  
  (define type-to-external-form
    (lambda (ty)
      (cases type ty
        (int-type () 'int)
        (bool-type () 'bool)
        (list-type (ty) (list 'listof (type-to-external-form ty)))
        (refto-type (ty) (list 'refto (type-to-external-form ty)))
        (void-type () 'void)
        (proc-type (arg-type result-type)
                   (list
                    (type-to-external-form arg-type)
                    '->
                    (type-to-external-form result-type)))
        (tvar-type (serial-number)
                   (string->symbol
                    (string-append
                     "tvar"
                     (number->string serial-number)))))))
  
  )